In this report, we reproduce the analyses in the fMRI study 1.

prep data

First, we load the relevant packages, define functions and plotting aesthetics, and load and tidy the data.

load packages

library(pacman)
pacman::p_load(tidyverse, purrr, fs, knitr, lmerTest, ggeffects, kableExtra, boot, devtools, install = TRUE)
devtools::install_github("hadley/emo")

define functions

source("https://gist.githubusercontent.com/benmarwick/2a1bb0133ff568cbe28d/raw/fb53bd97121f7f9ce947837ef1a4c65a73bffb3f/geom_flat_violin.R")

# MLM results table function
table_model = function(model_data, print = TRUE) {
  table = model_data %>%
    broom.mixed::tidy(conf.int = TRUE) %>%
    filter(effect == "fixed") %>%
    rename("SE" = std.error,
           "t" = statistic,
           "p" = p.value) %>%
    select(-group, -effect) %>%
    mutate_at(vars(-contains("term"), -contains("p")), round, 2) %>%
    mutate(term = gsub("cond", "", term),
           term = gsub("\\(Intercept\\)", "intercept", term),
           term = gsub("condother", "other", term),
           term = gsub("condself", "self", term),
           term = gsub("siteUSA", "sample (USA)", term),
           term = gsub("self_referential", "self-referential", term),
           term = gsub("self_relevance", "self-relevance", term),
           term = gsub("social_relevance", "social relevance", term),
           term = gsub(":", " x ", term),
           p = ifelse(p < .001, "< .001",
               ifelse(p == 1, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p)))),
           `b [95% CI]` = sprintf("%.2f [%0.2f, %.2f]", estimate, conf.low, conf.high)) %>%
    select(term, `b [95% CI]`, df, t, p)
  
  if (isTRUE(print)) {
    table  %>%
      kable() %>%
      kableExtra::kable_styling()
  } else {
    table
  }
}

simple_slopes = function(model, var, moderator, continuous = TRUE) {
  
  if (isTRUE(continuous)) {
    emmeans::emtrends(model, as.formula(paste("~", moderator)), var = var) %>%
      data.frame() %>%
      rename("trend" = 2) %>%
      mutate(`b [95% CI]` = sprintf("%.2f [%.2f, %.2f]", trend, asymp.LCL, asymp.UCL)) %>%
      select(!!moderator, `b [95% CI]`) %>%
      kable()  %>%
      kableExtra::kable_styling()
    
  } else {
    confint(emmeans::contrast(emmeans::emmeans(model, as.formula(paste("~", var, "|", moderator))), "revpairwise", by = moderator, adjust = "none")) %>%
      data.frame() %>%
      filter(grepl("control", contrast)) %>%
      mutate(`b [95% CI]` = sprintf("%.2f [%.2f, %.2f]", estimate, asymp.LCL, asymp.UCL)) %>%
      select(contrast, !!moderator, `b [95% CI]`) %>%
      arrange(contrast) %>%
      kable()  %>%
      kableExtra::kable_styling()
  }
}

define aesthetics

palette_condition = c("self" = "#ee9b00",
                      "control" = "#bb3e03",
                      "other" = "#005f73")
palette_roi = c("self-referential" = "#ee9b00",
               "mentalizing" = "#005f73")
palette_dv = c("self-relevance" = "#ee9b00",
               "social relevance" = "#005f73",
               "sharing" = "#56282D")
palette_sample = c("Netherlands" = "#027EA1",
                 "USA" = "#334456")

plot_aes = theme_minimal() +
  theme(legend.position = "top",
        legend.text = element_text(size = 12),
        text = element_text(size = 16, family = "Futura Medium"),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        axis.text = element_text(color = "black"),
        axis.line = element_line(colour = "black"),
        axis.ticks.y = element_blank())

load and tidy data

merged_all = read.csv("../data/study1_data.csv")

merged = merged_all %>%
  filter(outlier == "no" | is.na(outlier)) %>%
  filter(atlas %in% c("self-referential", "mentalizing")) %>%
  group_by(pID, atlas) %>%
  mutate(parameter_estimate_std = parameter_estimate / sd(parameter_estimate, na.rm = TRUE)) 

merged_wide = merged %>%
  select(pID, site, trial, cond, value, self_relevance, social_relevance, atlas, parameter_estimate_std) %>%
  spread(atlas, parameter_estimate_std) %>%
  rename("self_referential" = `self-referential`)

quality check

Check the data quality and identify missing data

check number of participants

merged_wide %>%
  select(pID, site) %>%
  group_by(site) %>%
  unique() %>%
  summarize(n = n()) %>%
  arrange(n) %>%
  rename("sample" = site) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()
sample n
Netherlands 40
USA 44

check number of trials

Print participant IDs who have < 72 trials

merged_wide %>%
  group_by(pID) %>%
  summarize(n = n()) %>%
  filter(n < 72) %>%
  arrange(n) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()
pID n
BPP65 59
BPP52 62
BPA23 63
BPA34 63
BPP21 63
BPA45 67
BPP05 67
BPP61 67
BPA29 68
BPA47 68
BPP64 68
BPP56 69
BPA04 70
BPA12 70
BPP20 70
BPP58 70
BPA02 71
BPA05 71
BPA08 71
BPA16 71
BPA31 71
BPA32 71
BPA33 71
BPA35 71
BPA37 71
BPA38 71
BPA46 71
BPP22 71
BPP67 71

check missing response data

Print participant IDs who have > 0 missing responses

merged_wide %>%
  filter(is.na(value)) %>%
  group_by(pID) %>%
  summarize(n = n()) %>%
  arrange(-n) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()
pID n
BPA10 12
BPA35 12
BPP21 10
BPA45 9
BPA12 8
BPA33 4
BPP60 3
BPP20 2
BPP26 2
BPP56 2
BPP66 2
BPA02 1
BPA03 1
BPA04 1
BPA08 1
BPA27 1
BPA32 1
BPP12 1
BPP15 1
BPP29 1
BPP33 1
BPP47 1
BPP49 1
BPP65 1

check global signal

These plots are before outliers were excluded

all trials

merged_all %>%
  ggplot(aes("", global_mean, fill = cond)) +
  geom_flat_violin(position = position_nudge(x = .15, y = 0), color = FALSE, alpha = .5) +
  coord_flip() +
  geom_point(aes(color = cond), position = position_jitter(width = .05), size = .1, alpha = .2) + 
  geom_boxplot(width = .1, outlier.shape = NA, color = "black", position = position_dodge(.15)) +
  scale_fill_manual(values = palette_condition) +
  scale_color_manual(values = palette_condition) +
  scale_x_discrete(expand = c(0, .1)) +
  labs(x = "") + 
  plot_aes

individual averages

merged_all %>%
  group_by(pID, cond) %>%
  summarize(global_mean = mean(global_mean, na.rm = TRUE)) %>%
  ggplot(aes("", global_mean, fill = cond)) +
  geom_flat_violin(position = position_nudge(x = .15, y = 0), color = FALSE, alpha = .5) +
  coord_flip() +
  geom_point(aes(color = cond), position = position_jitter(width = .05), size = 1, alpha = .5) + 
  geom_boxplot(width = .1, outlier.shape = NA, color = "black", position = position_dodge(.15)) +
  scale_fill_manual(values = palette_condition) +
  scale_color_manual(values = palette_condition) +
  scale_x_discrete(expand = c(0, .1)) +
  labs(x = "") + 
  plot_aes

number of outliers

merged_all %>%
  group_by(outlier) %>%
  summarize(n = n()) %>%
  spread(outlier, n) %>%
  mutate(percent = round((yes / (yes + no)) * 100, 1))



descriptives

Summarize means, SDs, and correlations between the ROIs

ratings

merged_wide %>%
  gather(variable, value, value, self_relevance, social_relevance) %>%
  group_by(variable) %>%
  summarize(M = mean(value, na.rm = TRUE),
            SD = sd(value, na.rm = TRUE)) %>%
  mutate(variable = ifelse(variable == "self_relevance", "self-relevance",
                    ifelse(variable == "social_relevance", "social relevance", "sharing intention"))) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()
variable M SD
self-relevance 2.57 1.01
social relevance 2.67 0.96
sharing intention 2.62 1.02

ROI activity

merged_wide %>%
  gather(variable, value, mentalizing, self_referential) %>%
  group_by(variable) %>%
  summarize(M = mean(value, na.rm = TRUE),
            SD = sd(value, na.rm = TRUE)) %>%
  kable(digits = 2) %>%
  kableExtra::kable_styling()
variable M SD
mentalizing 0.35 1.09
self_referential 0.13 1.11

ROI correlations

Correlation between self-referential and mentalizing ROIs. Given the high correlations, we also report sensitivity analyses with alternative, less highly correlated ROIs. Note, we do not include both ROIs in the same model, so multicollinearity is not an issue.

merged %>%
  select(pID, trial, cond, atlas, parameter_estimate) %>%
  spread(atlas, parameter_estimate) %>%
  rmcorr::rmcorr(as.factor(pID), mentalizing, `self-referential`, data = .)
## 
## Repeated measures correlation
## 
## r
## 0.9387811
## 
## degrees of freedom
## 5862
## 
## p-value
## 0
## 
## 95% confidence interval
## 0.9356678 0.9417483

replication analyses

H1

Is greater activity in the ROIs associated with higher self and social relevance ratings?

self-referential ROI

✅ H1a: Greater activity in the self-referential ROI will be associated with higher self-relevance ratings

mod_h1a =  lmer(self_relevance ~ self_referential + (1 + self_referential | pID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h1a)
term b [95% CI] df t p
intercept 2.56 [2.48, 2.64] 83.05 65.52 < .001
self-referential 0.05 [0.02, 0.08] 81.67 3.87 < .001

summary

summary(mod_h1a)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_relevance ~ self_referential + (1 + self_referential | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16538.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.4391 -0.7039  0.1481  0.6862  2.3668 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  pID      (Intercept)      0.115118 0.33929       
##           self_referential 0.001386 0.03723  -0.83
##  Residual                  0.912809 0.95541       
## Number of obs: 5947, groups:  pID, 84
## 
## Fixed effects:
##                  Estimate Std. Error       df t value             Pr(>|t|)    
## (Intercept)       2.56181    0.03910 83.05270   65.52 < 0.0000000000000002 ***
## self_referential  0.05015    0.01296 81.67244    3.87             0.000218 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## self_rfrntl -0.291

mentalizing ROI

✅ H1b: Greater activity in the mentalizing ROI will be associated with higher social relevance ratings

mod_h1b = lmer(social_relevance ~ mentalizing + (1 + mentalizing | pID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h1b)
term b [95% CI] df t p
intercept 2.66 [2.57, 2.74] 83.38 63.25 < .001
mentalizing 0.05 [0.02, 0.07] 82.59 4.00 < .001

summary

summary(mod_h1b)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: social_relevance ~ mentalizing + (1 + mentalizing | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 15624.4
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.8452 -0.7220  0.1678  0.6503  2.6868 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr 
##  pID      (Intercept) 0.135380 0.36794       
##           mentalizing 0.001707 0.04131  -0.05
##  Residual             0.778214 0.88216       
## Number of obs: 5947, groups:  pID, 84
## 
## Fixed effects:
##             Estimate Std. Error       df t value             Pr(>|t|)    
## (Intercept)  2.65549    0.04199 83.37522  63.248 < 0.0000000000000002 ***
## mentalizing  0.04917    0.01229 82.59246   4.002             0.000136 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## mentalizing -0.109

combined plot

predicted = ggeffects::ggpredict(mod_h1a, c("self_referential [-4.5:5]")) %>%
  data.frame() %>%
  mutate(roi = "self-referential",
         variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h1b, c("mentalizing [-4.5:5]")) %>%
              data.frame() %>%
              mutate(roi = "mentalizing",
                     variable = "social relevance"))

ind_data = merged_wide %>%
  select(pID, trial, contains("relevance"), mentalizing, self_referential) %>%
  rename("self-referential" = self_referential) %>%
  gather(variable, predicted, contains("relevance")) %>%
  mutate(variable = gsub("self_relevance", "self-relevance", variable),
         variable = gsub("social_relevance", "social relevance", variable)) %>%
  gather(roi, x, mentalizing, `self-referential`) %>%
  filter(!(variable == "self-relevance" & roi == "mentalizing") & ! (variable == "social relevance" & roi == "self-referential"))

(plot_h1 = predicted %>%
  ggplot(aes(x, predicted)) +
  stat_smooth(data = ind_data, aes(group = pID, color = roi), geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high, fill = roi), alpha = .3, color = NA) +
  geom_line(aes(color = roi), size = 2) +
  facet_grid(~variable) +
  scale_color_manual(name = "", values = palette_roi, guide = FALSE) +
  scale_fill_manual(name = "", values = palette_roi, guide = FALSE) +
  labs(x = "\nROI activity (SD)", y = "predicted rating\n") +
  plot_aes  +
  theme(legend.position = "top",
        legend.key.width=unit(2,"cm")))

H2

Do the manipulations increase relevance?

self-relevance

❌ H2a: Self-focused intervention (compared to control) will increase self-relevance

mod_h2a = lmer(self_relevance ~ cond + (1 | pID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h2a)
term b [95% CI] df t p
intercept 2.56 [2.47, 2.64] 120.75 60.24 < .001
other 0.01 [-0.05, 0.07] 5861.26 0.27 .789
self 0.03 [-0.03, 0.09] 5861.28 1.03 .303

summary

summary(mod_h2a)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_relevance ~ cond + (1 | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16562.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.4312 -0.7091  0.1662  0.6719  2.3463 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  pID      (Intercept) 0.1124   0.3353  
##  Residual             0.9167   0.9575  
## Number of obs: 5947, groups:  pID, 84
## 
## Fixed effects:
##                Estimate  Std. Error          df t value            Pr(>|t|)    
## (Intercept)    2.556444    0.042434  120.748005  60.245 <0.0000000000000002 ***
## condother      0.008148    0.030414 5861.256361   0.268               0.789    
## condself       0.031314    0.030414 5861.275639   1.030               0.303    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##           (Intr) cndthr
## condother -0.358       
## condself  -0.358  0.500

social relevance

❌ H2b: Other-focused intervention (compared to control) will increase social relevance

mod_h2b = lmer(social_relevance ~ cond + (1 | pID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h2b)
term b [95% CI] df t p
intercept 2.64 [2.55, 2.73] 110.22 59.25 < .001
other 0.05 [-0.01, 0.10] 5861.22 1.73 .084
self 0.05 [-0.01, 0.10] 5861.23 1.61 .108

summary

summary(mod_h2b)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: social_relevance ~ cond + (1 | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 15643.8
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.7871 -0.7191  0.1679  0.6563  2.6900 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  pID      (Intercept) 0.1339   0.3659  
##  Residual             0.7821   0.8844  
## Number of obs: 5947, groups:  pID, 84
## 
## Fixed effects:
##               Estimate Std. Error         df t value            Pr(>|t|)    
## (Intercept)    2.64227    0.04460  110.22273  59.249 <0.0000000000000002 ***
## condother      0.04859    0.02809 5861.22070   1.730              0.0838 .  
## condself       0.04519    0.02809 5861.23473   1.609              0.1077    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##           (Intr) cndthr
## condother -0.315       
## condself  -0.315  0.500

combined plot

predicted_h2 = ggeffects::ggpredict(mod_h2a, c("cond")) %>%
  data.frame() %>%
  mutate(model = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h2b, c("cond")) %>%
              data.frame() %>%
              mutate(model = "social relevance")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))

ind_data_h2 = merged_wide %>%
  rename("x" = cond) %>%
  gather(model, predicted, self_relevance, social_relevance) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")),
         model = gsub("self_relevance", "self-relevance", model),
         model = gsub("social_relevance", "social relevance", model))
  
(plot_h2 = predicted_h2 %>%
  ggplot(aes(x = x, y = predicted)) +
  stat_summary(data = ind_data_h2, aes(group = pID), fun = "mean", geom = "line",
               size = .1, color = "grey50") +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1) +
  geom_pointrange(aes(color = x, ymin = conf.low, ymax = conf.high), size = .75) +
  facet_grid(~model) +
  scale_color_manual(name = "", values = palette_condition, guide = "none") +
  scale_alpha_manual(name = "", values = c(1, .5)) +
  labs(x = "", y = "predicted rating\n") +
  plot_aes +
  theme(legend.position = c(.85, .15)))

H3

Is greater self and social relevance associated with higher sharing intentions?

✅ H1a: Greater self-relevance ratings will be associated with higher sharing intentions

✅ H1a: Greater social relevance ratings will be associated with higher sharing intentions

mod_h3 = lmer(value ~ self_relevance + social_relevance + (1 + self_relevance + social_relevance | pID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

plot

predicted = ggeffects::ggpredict(mod_h3, c("self_relevance")) %>%
  data.frame() %>%
  mutate(variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h3, c("social_relevance")) %>%
              data.frame() %>%
              mutate(variable = "social relevance"))

points = merged_wide %>%
  rename("self-referential" = self_referential,
         "predicted" = value) %>%
  gather(variable, x, contains("relevance")) %>%
  mutate(variable = gsub("self_relevance", "self-relevance", variable),
         variable = gsub("social_relevance", "social relevance", variable))

(plot_rel_sharing = predicted %>%
  ggplot(aes(x, predicted)) +
  stat_smooth(data = points, aes(group = pID, color = variable),
              geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high, fill = variable), alpha = .2, color = NA) +
  geom_line(aes(color = variable), size = 1.5) +
  facet_grid(~variable) +
  scale_color_manual(name = "", values = palette_dv[1:2]) +
  scale_fill_manual(name = "", values = palette_dv[1:2]) +
  labs(x = "\nrelevance rating", y = "predicted sharing intention rating\n") +
  plot_aes +
    theme(legend.position = "none"))

model table

table_model(mod_h3)
term b [95% CI] df t p
intercept 1.18 [1.06, 1.31] 75.94 18.66 < .001
self-relevance 0.30 [0.26, 0.34] 84.89 15.44 < .001
social relevance 0.25 [0.20, 0.30] 81.83 9.60 < .001

summary

summary(mod_h3)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ self_relevance + social_relevance + (1 + self_relevance +  
##     social_relevance | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 14760.1
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.3568 -0.7033  0.0600  0.6924  3.0353 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr       
##  pID      (Intercept)      0.21657  0.4654              
##           self_relevance   0.01124  0.1060   -0.19      
##           social_relevance 0.03324  0.1823   -0.60 -0.58
##  Residual                  0.68963  0.8304              
## Number of obs: 5868, groups:  pID, 84
## 
## Fixed effects:
##                  Estimate Std. Error       df t value             Pr(>|t|)    
## (Intercept)       1.18347    0.06342 75.94066  18.662 < 0.0000000000000002 ***
## self_relevance    0.30150    0.01953 84.88987  15.440 < 0.0000000000000002 ***
## social_relevance  0.25231    0.02627 81.83061   9.604  0.00000000000000464 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) slf_rl
## self_relvnc -0.220       
## socil_rlvnc -0.564 -0.607

preregistered analyses

Link to the preregistration

Deviations:

  • removed condition slope as a random effect in the following models because they did not converge in H5


H4

Do the manipulations increase neural activity in brain regions associated with self-referential processing and mentalizing?

self-referential ROI

✅ H4a: Self-focused intervention (compared to control) will increase brain activity in ROIs related to self-referential processes.

mod_h4a = lmer(self_referential ~ cond + (1 + cond | pID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h4a)
term b [95% CI] df t p
intercept 0.07 [-0.04, 0.18] 83.04 1.22 .224
other 0.08 [0.00, 0.16] 82.61 2.06 .042
self 0.10 [0.01, 0.18] 82.63 2.30 .024

summary

summary(mod_h4a)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_referential ~ cond + (1 + cond | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 17090.1
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.7877 -0.6604  0.0043  0.6513  3.5927 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr       
##  pID      (Intercept) 0.22481  0.4741              
##           condother   0.04129  0.2032   -0.28      
##           condself    0.07290  0.2700   -0.03  0.72
##  Residual             0.98184  0.9909              
## Number of obs: 5947, groups:  pID, 84
## 
## Fixed effects:
##             Estimate Std. Error       df t value Pr(>|t|)  
## (Intercept)  0.06895    0.05632 83.04194   1.224   0.2243  
## condother    0.07949    0.03851 82.60927   2.064   0.0421 *
## condself     0.09896    0.04312 82.62924   2.295   0.0243 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##           (Intr) cndthr
## condother -0.376       
## condself  -0.222  0.581

mentalizing ROI

✅❌ H4b: Other-focused intervention (compared to control) will increase brain activity in ROIs related to mentalizing processes.

The other condition is associated with increased activation in the mentalizing ROI. However, when condition is allowed to vary randomly across people, the relationship is not statistically significant.

mod_h4b = lmer(mentalizing ~ cond + (1 + cond | pID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h4b)
term b [95% CI] df t p
intercept 0.31 [0.20, 0.41] 83.04 5.77 < .001
other 0.06 [-0.02, 0.13] 82.51 1.52 .133
self 0.08 [0.00, 0.17] 82.68 1.99 .049

summary

summary(mod_h4b)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: mentalizing ~ cond + (1 + cond | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 17084.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.6133 -0.6604  0.0242  0.6724  3.3541 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr       
##  pID      (Intercept) 0.19594  0.4426              
##           condother   0.03830  0.1957   -0.29      
##           condself    0.06797  0.2607    0.03  0.70
##  Residual             0.98339  0.9917              
## Number of obs: 5947, groups:  pID, 84
## 
## Fixed effects:
##             Estimate Std. Error       df t value    Pr(>|t|)    
## (Intercept)  0.30694    0.05319 83.04393   5.771 0.000000132 ***
## condother    0.05782    0.03806 82.50893   1.519      0.1325    
## condself     0.08468    0.04245 82.68091   1.995      0.0494 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##           (Intr) cndthr
## condother -0.395       
## condself  -0.202  0.571

combined plot

predicted_h4 = ggeffects::ggpredict(mod_h4a, c("cond")) %>%
  data.frame() %>%
  mutate(atlas = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h4b, c("cond")) %>%
              data.frame() %>%
              mutate(atlas = "mentalizing")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")),
         atlas = factor(atlas, levels = c("self-referential", "mentalizing")))

ind_data_h4 = merged %>%
  select(pID, cond, run, trial, atlas, parameter_estimate_std) %>%
  unique() %>%
  rename("x" = cond,
         "predicted" = parameter_estimate_std) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")),
         atlas = factor(atlas, levels = c("self-referential", "mentalizing")))

(plot_h4 = predicted_h4 %>%
  ggplot(aes(x = x, y = predicted)) +
  stat_summary(data = ind_data_h4, aes(group = pID), fun = "mean", geom = "line",
               size = .1, color = "grey50") +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1) +
  geom_pointrange(aes(color = x, ymin = conf.low, ymax = conf.high), size = .75) +
  facet_grid(~atlas) +
  scale_color_manual(name = "", values = palette_condition, guide = "none") +
  scale_alpha_manual(name = "", values = c(1, .5)) +
  labs(x = "", y = "ROI activity (SD)\n") +
  plot_aes +
  theme(legend.position = c(.85, .15)))

H5

Do the manipulations increase sharing intentions?

❌ H5a: Self-focused intervention (compared to control) will increase sharing intentions

❌ H5b: Other-focused intervention (compared to control) will increase sharing intentions

mod_h5 = lmer(value ~ cond + (1 | pID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

plot

predicted_h5 = ggeffects::ggpredict(mod_h5, c("cond")) %>%
  data.frame() %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))

ind_data_h5 = merged_wide %>%
  rename("x" = cond,
         "predicted" = value) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))
  
predicted_h5 %>%
  ggplot(aes(x = x, y = predicted)) +
  stat_summary(data = ind_data_h5, aes(group = pID), fun = "mean", geom = "line",
               size = .25, color = "grey50") +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1.5) +
  geom_pointrange(aes(color = x, ymin = conf.low, ymax = conf.high), size = 1.5) +
  scale_color_manual(name = "", values = palette_condition, guide = "none") +
  scale_alpha_manual(name = "", values = c(1, .5)) +
  labs(x = "", y = "predicted sharing intention\n") +
  plot_aes +
  theme(legend.position = c(.85, .15))

model table

table_model(mod_h5)
term b [95% CI] df t p
intercept 2.64 [2.56, 2.73] 124.03 63.03 < .001
other -0.03 [-0.09, 0.03] 5782.51 -1.01 .312
self -0.05 [-0.11, 0.02] 5782.52 -1.47 .141

summary

summary(mod_h5)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ cond + (1 | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16481.5
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.5589 -0.7087  0.1131  0.7277  2.0404 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  pID      (Intercept) 0.1076   0.3280  
##  Residual             0.9392   0.9691  
## Number of obs: 5868, groups:  pID, 84
## 
## Fixed effects:
##               Estimate Std. Error         df t value            Pr(>|t|)    
## (Intercept)    2.64482    0.04196  124.02667  63.031 <0.0000000000000002 ***
## condother     -0.03133    0.03099 5782.50986  -1.011               0.312    
## condself      -0.04558    0.03099 5782.52275  -1.470               0.141    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##           (Intr) cndthr
## condother -0.369       
## condself  -0.369  0.500

H6

Is ROI activity positively related to sharing intentions?

self-referential ROI

✅ H6a: Stronger activity in the self-referential ROI will be related to higher sharing intentions.

mod_h6a = lmer(value ~ self_referential + (1 + self_referential | pID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h6a)
term b [95% CI] df t p
intercept 2.61 [2.53, 2.68] 83.33 67.97 < .001
self-referential 0.08 [0.06, 0.11] 80.66 6.19 < .001

summary

summary(mod_h6a)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ self_referential + (1 + self_referential | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16433.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.6008 -0.7261  0.1094  0.7358  2.2570 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  pID      (Intercept)      0.109505 0.33091       
##           self_referential 0.002351 0.04849  -0.21
##  Residual                  0.929645 0.96418       
## Number of obs: 5868, groups:  pID, 84
## 
## Fixed effects:
##                  Estimate Std. Error       df t value             Pr(>|t|)    
## (Intercept)       2.60692    0.03835 83.32776  67.974 < 0.0000000000000002 ***
## self_referential  0.08432    0.01362 80.65926   6.194         0.0000000234 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## self_rfrntl -0.117

mentalizing ROI

✅ H6b: Stronger activation in the mentalizing ROI will be related to higher sharing intentions.

mod_h6b = lmer(value ~ mentalizing + (1 + mentalizing | pID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_model(mod_h6b)
term b [95% CI] df t p
intercept 2.59 [2.52, 2.67] 84.15 67.29 < .001
mentalizing 0.08 [0.05, 0.10] 80.98 5.58 < .001

summary

summary(mod_h6b)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ mentalizing + (1 + mentalizing | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16443.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.5897 -0.7235  0.1110  0.7388  2.2032 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr 
##  pID      (Intercept) 0.109159 0.33039       
##           mentalizing 0.001947 0.04412  -0.08
##  Residual             0.931599 0.96519       
## Number of obs: 5868, groups:  pID, 84
## 
## Fixed effects:
##             Estimate Std. Error       df t value             Pr(>|t|)    
## (Intercept)  2.59169    0.03851 84.14577  67.295 < 0.0000000000000002 ***
## mentalizing  0.07509    0.01346 80.98040   5.577          0.000000314 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr)
## mentalizing -0.136

combined plot

vals = seq(-4.5,4.5,.1)

predicted_h6 = ggeffects::ggpredict(mod_h6a, c("self_referential [vals]")) %>%
  data.frame() %>%
  mutate(roi = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h6b, c("mentalizing [vals]")) %>%
              data.frame() %>%
              mutate(roi = "mentalizing")) %>%
  mutate(roi = factor(roi, levels = c("self-referential", "mentalizing")))

ind_data_h6 = merged %>%
  select(pID, cond, run, trial, atlas, parameter_estimate_std, value) %>%
  rename("x" = parameter_estimate_std,
         "predicted" = value,
         "roi" = atlas) %>%
  mutate(roi = factor(roi, levels = c("self-referential", "mentalizing")))

predicted_h6 %>%
  ggplot(aes(x = x, y = predicted, color = roi, fill = roi)) +
  stat_smooth(data = ind_data_h6, aes(group = pID), geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .2, color = NA) +
  geom_line(size = 2) +
  facet_grid(~roi) +
  scale_color_manual(name = "", values = palette_roi) +
  scale_fill_manual(name = "", values = palette_roi) +
  labs(y = "predicted sharing intention\n", x = "\nROI activity (SD)") +
  plot_aes +
  theme(legend.position = "none")

H7

Is there an indirect effect of the condition on sharing intentions through activity in self-referential and mentalizing ROIs?

prep data

# source functions
source("indirectMLM.R")

# create self condition dataframe
data_med_self = merged %>%
  filter(!cond == "other" & atlas == "self-referential") %>%
  mutate(cond = ifelse(cond == "self", 1, 0)) %>%
  select(pID, site, trial, cond, value, parameter_estimate) %>%
  data.frame()

# create social condition dataframe
data_med_other = merged %>%
  filter(!cond == "self" & atlas == "mentalizing") %>%
  mutate(cond = ifelse(cond == "other", 1, 0)) %>%
  select(pID, site, trial, cond, value, parameter_estimate) %>%
  data.frame()

# define variables
y_var = "value"
m_var = "parameter_estimate"

self condition

✅ H7a: The effect of Self-focused intervention on sharing intention is mediated by increased activity in the self-referential ROI.

model_name = "mediation_self"
data = data_med_self

if (file.exists(sprintf("models/model_%s.RDS", model_name))) {
  assign(get("model_name"), readRDS(sprintf("models/model_%s.RDS", model_name)))
} else {
  assign(get("model_name"), boot(data = data, statistic = indirect.mlm, R = 500,
                                 y = y_var, x = "cond", mediator = m_var, group.id = "pID",
                                 between.m = F, uncentered.x = F))
  saveRDS(eval(parse(text = model_name)), sprintf("models/model_%s.RDS", model_name))
}

indirect.mlm.summary(get(model_name))
## #### Population Covariance ####
## Covariance of Random Slopes a and b: 0.001 [-0.003, 0.01]
## 
## 
## #### Indirect Effects ####
## # Within-subject Effects
## Unbiased Estimate of Within-subjects Indirect Effect: 0.007 [0.002, 0.018]
## Biased Estimate of Within-subjects Indirect Effect: 0.006 [0, 0.013]
## Bias in Within-subjects Indirect Effect: 0.001 [0, 0.009]
## 
## 
## #### Total Effect ####
## Unbiased Estimate of Total Effect: -0.047 [-0.109, 0.009]
## Biased Total Effect of X on Y (c path): -0.045 [-0.104, 0.012]
## Bias in Total Effect: 0.002 [0, 0.007]
## 
## 
## #### Direct Effects ####
## Direct Effect of Predictor on Dependent Variable (c' path): -0.054 [-0.119, -0.003]
## Within-subjects Effect of Predictor on Mediator (a path for group-mean centered predictor): 0.033 [0.002, 0.064]
## Within-subjects Effect of Mediator on Dependent Variable (b path for group-mean centered mediator): 0.172 [0.115, 0.264]

other condition

❌ H7b: The effect of Other-focused intervention on sharing intention is mediated by increased activity in the mentalizing ROI.

model_name = "mediation_other"
data = data_med_other

if (file.exists(sprintf("models/model_%s.RDS", model_name))) {
  assign(get("model_name"), readRDS(sprintf("models/model_%s.RDS", model_name)))
} else {
  assign(get("model_name"), boot(data = data, statistic = indirect.mlm, R = 500,
                                 y = y_var, x = "cond", mediator = m_var, group.id = "pID",
                                 between.m = F, uncentered.x = F))
  saveRDS(eval(parse(text = model_name)), sprintf("models/model_%s.RDS", model_name))
}

indirect.mlm.summary(get(model_name))
## #### Population Covariance ####
## Covariance of Random Slopes a and b: 0 [-0.005, 0.006]
## 
## 
## #### Indirect Effects ####
## # Within-subject Effects
## Unbiased Estimate of Within-subjects Indirect Effect: 0.003 [-0.003, 0.012]
## Biased Estimate of Within-subjects Indirect Effect: 0.003 [-0.002, 0.01]
## Bias in Within-subjects Indirect Effect: 0 [0, 0.007]
## 
## 
## #### Total Effect ####
## Unbiased Estimate of Total Effect: -0.03 [-0.091, 0.034]
## Biased Total Effect of X on Y (c path): -0.031 [-0.091, 0.035]
## Bias in Total Effect: 0.001 [0, 0.005]
## 
## 
## #### Direct Effects ####
## Direct Effect of Predictor on Dependent Variable (c' path): -0.033 [-0.096, 0.028]
## Within-subjects Effect of Predictor on Mediator (a path for group-mean centered predictor): 0.016 [-0.007, 0.043]
## Within-subjects Effect of Mediator on Dependent Variable (b path for group-mean centered mediator): 0.188 [0.146, 0.316]

exploratory moderation by cultural context

These analyses explore whether the analyses reported in study 1 of the main manuscript are moderated by cultural context (the Netherlands or the USA).

H1

Are the relationships between ROI activity and self and social relevance ratings moderated by cultural context?

self-referential ROI

These data are not consistent with moderation by cultural context.

mod_h1a =  lmer(self_relevance ~ self_referential * site + (1 + self_referential | pID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h1a = table_model(mod_h1a, print = FALSE)

table_h1a %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept 2.61 [2.50, 2.72] 81.70 46.20 < .001
self-referential 0.04 [0.01, 0.08] 83.16 2.32 .023
sample (USA) -0.09 [-0.25, 0.06] 82.60 -1.17 .244
self-referential x sample (USA) 0.01 [-0.04, 0.07] 81.67 0.51 .613

simple slopes

simple_slopes(mod_h1a, "self_referential", "site")
site b [95% CI]
Netherlands 0.04 [0.01, 0.08]
USA 0.06 [0.02, 0.09]

summary

summary(mod_h1a)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_relevance ~ self_referential * site + (1 + self_referential |  
##     pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16545.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.4452 -0.7040  0.1527  0.6840  2.3714 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  pID      (Intercept)      0.114518 0.33840       
##           self_referential 0.001534 0.03917  -0.78
##  Residual                  0.912792 0.95540       
## Number of obs: 5947, groups:  pID, 84
## 
## Fixed effects:
##                          Estimate Std. Error       df t value
## (Intercept)               2.60910    0.05647 81.69581  46.201
## self_referential          0.04405    0.01900 83.15566   2.318
## siteUSA                  -0.09178    0.07825 82.59727  -1.173
## self_referential:siteUSA  0.01327    0.02615 81.67123   0.507
##                                     Pr(>|t|)    
## (Intercept)              <0.0000000000000002 ***
## self_referential                      0.0229 *  
## siteUSA                               0.2442    
## self_referential:siteUSA              0.6132    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) slf_rf sitUSA
## self_rfrntl -0.219              
## siteUSA     -0.722  0.158       
## slf_rfr:USA  0.159 -0.727 -0.278

mentalizing ROI

These data are not consistent with moderation by cultural context.

mod_h1b = lmer(social_relevance ~ mentalizing * site + (1 + mentalizing | pID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h1b = table_model(mod_h1b, print = FALSE)

table_h1b %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept 2.73 [2.61, 2.85] 80.99 45.45 < .001
mentalizing 0.05 [0.01, 0.08] 82.37 2.58 .012
sample (USA) -0.14 [-0.30, 0.03] 82.36 -1.63 .107
mentalizing x sample (USA) 0.01 [-0.04, 0.06] 81.96 0.27 .786

simple slopes

simple_slopes(mod_h1b, "mentalizing", "site")
site b [95% CI]
Netherlands 0.05 [0.01, 0.08]
USA 0.05 [0.02, 0.09]

summary

summary(mod_h1b)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: social_relevance ~ mentalizing * site + (1 + mentalizing | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 15630.5
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.8495 -0.7194  0.1658  0.6490  2.6901 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr 
##  pID      (Intercept) 0.132307 0.36374       
##           mentalizing 0.001889 0.04347  -0.04
##  Residual             0.778190 0.88215       
## Number of obs: 5947, groups:  pID, 84
## 
## Fixed effects:
##                      Estimate Std. Error        df t value            Pr(>|t|)
## (Intercept)          2.725738   0.059976 80.991846  45.447 <0.0000000000000002
## mentalizing          0.046419   0.017967 82.371997   2.584              0.0115
## siteUSA             -0.135653   0.083233 82.356475  -1.630              0.1070
## mentalizing:siteUSA  0.006769   0.024800 81.955857   0.273              0.7856
##                        
## (Intercept)         ***
## mentalizing         *  
## siteUSA                
## mentalizing:siteUSA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) mntlzn sitUSA
## mentalizing -0.060              
## siteUSA     -0.721  0.043       
## mntlzng:USA  0.043 -0.724 -0.099

combined plot

predicted = ggeffects::ggpredict(mod_h1a, c("self_referential [-4.5:5]", "site")) %>%
  data.frame() %>%
  mutate(roi = "self-referential",
         variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h1b, c("mentalizing [-4.5:5]", "site")) %>%
              data.frame() %>%
              mutate(roi = "mentalizing",
                     variable = "social relevance"))

ind_data = merged_wide %>%
  select(site, pID, trial, contains("relevance"), mentalizing, self_referential) %>%
  rename("self-referential" = self_referential,
         "group" = site) %>%
  gather(variable, predicted, contains("relevance")) %>%
  mutate(variable = gsub("self_relevance", "self-relevance", variable),
         variable = gsub("social_relevance", "social relevance", variable)) %>%
  gather(roi, x, mentalizing, `self-referential`) %>%
  filter(!(variable == "self-relevance" & roi == "mentalizing") & ! (variable == "social relevance" & roi == "self-referential"))

(plot_h1 = predicted %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  stat_smooth(data = ind_data, aes(group = interaction(pID, group)), geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .3, color = NA) +
  geom_line(size = 2) +
  facet_grid(~variable) +
  scale_color_manual(name = "", values = palette_sample) +
  scale_fill_manual(name = "", values = palette_sample) +
  labs(x = "\nROI activity (SD)", y = "predicted rating\n") +
  plot_aes +
  theme(legend.position = "top",
        legend.key.width=unit(2,"cm")))

H2

Are the effects of the experimental manipulations on relevance moderated by cultural context?

self-relevance

These data are not consistent with moderation by cultural context.

mod_h2a = lmer(self_relevance ~ cond * site + (1 | pID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h2a = table_model(mod_h2a, print = FALSE)

table_h2a %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept 2.58 [2.46, 2.70] 119.16 41.92 < .001
other 0.04 [-0.05, 0.12] 5859.38 0.84 .400
self 0.04 [-0.04, 0.13] 5859.19 0.95 .344
sample (USA) -0.05 [-0.21, 0.12] 119.21 -0.53 .597
other x sample (USA) -0.06 [-0.17, 0.06] 5859.27 -0.91 .364
self x sample (USA) -0.02 [-0.14, 0.10] 5859.27 -0.33 .745

simple slopes

simple_slopes(mod_h2a, "cond", "site", continuous = FALSE)
contrast site b [95% CI]
other - control Netherlands 0.04 [-0.05, 0.12]
other - control USA -0.02 [-0.10, 0.06]
self - control Netherlands 0.04 [-0.04, 0.13]
self - control USA 0.02 [-0.06, 0.10]

summary

summary(mod_h2a)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_relevance ~ cond * site + (1 | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16572.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.4322 -0.7142  0.1660  0.6772  2.3255 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  pID      (Intercept) 0.1127   0.3357  
##  Residual             0.9169   0.9576  
## Number of obs: 5947, groups:  pID, 84
## 
## Fixed effects:
##                     Estimate Std. Error         df t value            Pr(>|t|)
## (Intercept)          2.58005    0.06155  119.15936  41.920 <0.0000000000000002
## condother            0.03715    0.04409 5859.38190   0.843               0.400
## condself             0.04168    0.04403 5859.18542   0.947               0.344
## siteUSA             -0.04506    0.08505  119.20988  -0.530               0.597
## condother:siteUSA   -0.05531    0.06090 5859.27128  -0.908               0.364
## condself:siteUSA    -0.01982    0.06090 5859.27129  -0.325               0.745
##                      
## (Intercept)       ***
## condother            
## condself             
## siteUSA              
## condother:siteUSA    
## condself:siteUSA     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndthr cndslf sitUSA cndt:USA
## condother   -0.358                              
## condself    -0.358  0.500                       
## siteUSA     -0.724  0.259  0.259                
## cndthr:sUSA  0.259 -0.724 -0.362 -0.358         
## cndslf:sUSA  0.259 -0.361 -0.723 -0.358  0.500

social relevance

These data are not consistent with moderation by cultural context.

mod_h2b = lmer(social_relevance ~ cond * site + (1 | pID),
               data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h2b = table_model(mod_h2b, print = FALSE)

table_h2b %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept 2.73 [2.60, 2.86] 109.20 42.42 < .001
other 0.02 [-0.06, 0.10] 5859.32 0.42 .674
self 0.00 [-0.08, 0.08] 5859.17 0.06 .954
sample (USA) -0.16 [-0.34, 0.01] 109.23 -1.83 .069
other x sample (USA) 0.06 [-0.05, 0.17] 5859.24 1.07 .286
self x sample (USA) 0.08 [-0.03, 0.19] 5859.24 1.46 .145

simple slopes

simple_slopes(mod_h2b, "cond", "site", continuous = FALSE)
contrast site b [95% CI]
other - control Netherlands 0.02 [-0.06, 0.10]
other - control USA 0.08 [0.00, 0.15]
self - control Netherlands 0.00 [-0.08, 0.08]
self - control USA 0.08 [0.01, 0.16]

summary

summary(mod_h2b)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: social_relevance ~ cond * site + (1 | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 15650.9
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.7710 -0.7218  0.1749  0.6467  2.7193 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  pID      (Intercept) 0.1322   0.3637  
##  Residual             0.7821   0.8843  
## Number of obs: 5947, groups:  pID, 84
## 
## Fixed effects:
##                      Estimate  Std. Error          df t value
## (Intercept)          2.727601    0.064296  109.197589  42.423
## condother            0.017139    0.040721 5859.320147   0.421
## condself             0.002337    0.040665 5859.172101   0.057
## siteUSA             -0.162945    0.088845  109.234370  -1.834
## condother:siteUSA    0.060069    0.056248 5859.237040   1.068
## condself:siteUSA     0.081930    0.056241 5859.236796   1.457
##                              Pr(>|t|)    
## (Intercept)       <0.0000000000000002 ***
## condother                      0.6738    
## condself                       0.9542    
## siteUSA                        0.0694 .  
## condother:siteUSA              0.2856    
## condself:siteUSA               0.1452    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndthr cndslf sitUSA cndt:USA
## condother   -0.316                              
## condself    -0.317  0.500                       
## siteUSA     -0.724  0.229  0.229                
## cndthr:sUSA  0.229 -0.724 -0.362 -0.316         
## cndslf:sUSA  0.229 -0.361 -0.723 -0.316  0.500

combined plot

predicted_h2 = ggeffects::ggpredict(mod_h2a, c("cond", "site")) %>%
  data.frame() %>%
  mutate(model = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h2b, c("cond", "site")) %>%
              data.frame() %>%
              mutate(model = "social relevance")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))

ind_data_h2 = merged_wide %>%
  rename("x" = cond,
         "group" = site) %>%
  gather(model, predicted, self_relevance, social_relevance) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")),
         model = gsub("self_relevance", "self-relevance", model),
         model = gsub("social_relevance", "social relevance", model))
  
(plot_h2 = predicted_h2 %>%
  ggplot(aes(x = x, y = predicted, color = group)) +
  stat_summary(data = ind_data_h2, aes(group = pID), fun = "mean", geom = "line", size = .1) +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1, position = position_dodge(.1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high, group = group),
                  size = .75, position = position_dodge(.1)) +
  facet_grid(~model) +
  scale_color_manual(name = "", values = palette_sample) +
  labs(x = "", y = "predicted rating\n") +
  plot_aes +
  theme(legend.position = c(.85, .15)))

H3

Are the relationships between self and social relevance and sharing intentions moderated by cultural context?

These data are not consistent with moderation by cultural context.

mod_h3 = lmer(value ~ self_relevance * site + social_relevance * site + (1 + self_relevance + social_relevance | pID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

plot

predicted = ggeffects::ggpredict(mod_h3, c("self_relevance", "site")) %>%
  data.frame() %>%
  mutate(variable = "self-relevance") %>%
  bind_rows(ggeffects::ggpredict(mod_h3, c("social_relevance", "site")) %>%
              data.frame() %>%
              mutate(variable = "social relevance"))

points = merged_wide %>%
  rename("self-referential" = self_referential,
         "predicted" = value,
         "group" = site) %>%
  gather(variable, x, contains("relevance")) %>%
  mutate(variable = gsub("self_relevance", "self-relevance", variable),
         variable = gsub("social_relevance", "social relevance", variable))

(plot_rel_sharing = predicted %>%
  ggplot(aes(x, predicted, color = group, fill = group)) +
  stat_smooth(data = points, aes(group = interaction(pID, group)), geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .2, color = NA) +
  geom_line(size = 2) +
  facet_grid(~variable) +
  scale_color_manual(name = "", values = palette_sample) +
  scale_fill_manual(name = "", values = palette_sample) +
  labs(x = "\nrating", y = "predicted sharing intention\n") +
  plot_aes)

model table

table_h3 = table_model(mod_h3, print = FALSE)

table_h3 %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept 1.14 [0.95, 1.32] 82.45 11.97 < .001
self-relevance 0.32 [0.27, 0.38] 87.57 11.16 < .001
sample (USA) 0.09 [-0.17, 0.34] 76.19 0.69 .489
social relevance 0.23 [0.15, 0.31] 87.18 5.89 < .001
self-relevance x sample (USA) -0.04 [-0.12, 0.04] 83.20 -1.07 .289
sample (USA) x social relevance 0.04 [-0.06, 0.15] 81.62 0.81 .419

simple slopes

self-relevance

simple_slopes(mod_h3, "self_relevance", "site", continuous = TRUE)
site b [95% CI]
Netherlands 0.32 [0.27, 0.38]
USA 0.28 [0.23, 0.33]

social -relevance

simple_slopes(mod_h3, "social_relevance", "site", continuous = TRUE)
site b [95% CI]
Netherlands 0.23 [0.15, 0.31]
USA 0.27 [0.20, 0.34]

summary

summary(mod_h3)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ self_relevance * site + social_relevance * site + (1 +  
##     self_relevance + social_relevance | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 14769.7
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.3624 -0.6964  0.0626  0.6910  3.0382 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr       
##  pID      (Intercept)      0.21802  0.4669              
##           self_relevance   0.01097  0.1047   -0.17      
##           social_relevance 0.03344  0.1829   -0.62 -0.57
##  Residual                  0.68974  0.8305              
## Number of obs: 5868, groups:  pID, 84
## 
## Fixed effects:
##                          Estimate Std. Error       df t value
## (Intercept)               1.13543    0.09482 82.45396  11.975
## self_relevance            0.32394    0.02901 87.57072  11.165
## siteUSA                   0.08877    0.12778 76.19224   0.695
## social_relevance          0.22983    0.03902 87.18020   5.889
## self_relevance:siteUSA   -0.04170    0.03909 83.20454  -1.067
## siteUSA:social_relevance  0.04297    0.05286 81.61652   0.813
##                                      Pr(>|t|)    
## (Intercept)              < 0.0000000000000002 ***
## self_relevance           < 0.0000000000000002 ***
## siteUSA                                 0.489    
## social_relevance                  0.000000071 ***
## self_relevance:siteUSA                  0.289    
## siteUSA:social_relevance                0.419    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) slf_rl sitUSA scl_rl s_:USA
## self_relvnc -0.213                            
## siteUSA     -0.742  0.158                     
## socil_rlvnc -0.582 -0.599  0.432              
## slf_rlv:USA  0.158 -0.742 -0.212  0.445       
## stUSA:scl_r  0.430  0.442 -0.576 -0.738 -0.603

H4

Are the effects of the experimental manipulations on ROI activity moderated by cultural context?

self-referential ROI

There is a main effect of site, such that the American cohort has greater activity in the self-referential ROI compared to the Dutch cohort.

These data are not consistent with moderation by cultural context.

mod_h4a = lmer(self_referential ~ cond * site + (1 + cond | pID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h4a = table_model(mod_h4a, print = FALSE)

table_h4a %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept -0.15 [-0.30, 0.00] 81.97 -1.99 .050
other 0.11 [-0.00, 0.22] 81.68 1.94 .055
self 0.09 [-0.04, 0.21] 81.47 1.35 .179
sample (USA) 0.42 [0.21, 0.62] 81.99 4.01 < .001
other x sample (USA) -0.06 [-0.21, 0.10] 81.60 -0.73 .470
self x sample (USA) 0.03 [-0.15, 0.20] 81.63 0.31 .761

simple slopes

simple_slopes(mod_h4a, "cond", "site", continuous = FALSE)
contrast site b [95% CI]
other - control Netherlands 0.11 [-0.00, 0.22]
other - control USA 0.05 [-0.05, 0.16]
self - control Netherlands 0.09 [-0.04, 0.21]
self - control USA 0.11 [-0.01, 0.23]

summary

summary(mod_h4a)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: self_referential ~ cond * site + (1 + cond | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 17083.2
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.7924 -0.6600  0.0034  0.6490  3.6052 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr       
##  pID      (Intercept) 0.18374  0.4287              
##           condother   0.04204  0.2050   -0.25      
##           condself    0.07469  0.2733   -0.06  0.73
##  Residual             0.98184  0.9909              
## Number of obs: 5947, groups:  pID, 84
## 
## Fixed effects:
##                   Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)       -0.14903    0.07505 81.96693  -1.986 0.050417 .  
## condother          0.10888    0.05598 81.67604   1.945 0.055219 .  
## condself           0.08506    0.06280 81.47167   1.354 0.179328    
## siteUSA            0.41622    0.10371 81.99399   4.013 0.000132 ***
## condother:siteUSA -0.05617    0.07733 81.59869  -0.726 0.469681    
## condself:siteUSA   0.02648    0.08682 81.63475   0.305 0.761141    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndthr cndslf sitUSA cndt:USA
## condother   -0.376                              
## condself    -0.258  0.586                       
## siteUSA     -0.724  0.272  0.187                
## cndthr:sUSA  0.272 -0.724 -0.424 -0.376         
## cndslf:sUSA  0.187 -0.424 -0.723 -0.258  0.586

mentalizing ROI

There is a main effect of site, such that the American cohort has greater activity in the self-referential ROI compared to the Dutch cohort.

These data are not consistent with moderation by cultural context.

mod_h4b = lmer(mentalizing ~ cond * site + (1 + cond | pID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h4b = table_model(mod_h4b, print = FALSE)

table_h4b %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept 0.12 [-0.03, 0.26] 82.03 1.61 .111
other 0.12 [0.01, 0.23] 81.59 2.14 .036
self 0.08 [-0.05, 0.20] 81.51 1.24 .217
sample (USA) 0.36 [0.17, 0.56] 82.06 3.68 < .001
other x sample (USA) -0.11 [-0.26, 0.04] 81.51 -1.49 .139
self x sample (USA) 0.01 [-0.16, 0.18] 81.68 0.17 .863

simple slopes

simple_slopes(mod_h4b, "cond", "site", continuous = FALSE)
contrast site b [95% CI]
other - control Netherlands 0.12 [0.01, 0.22]
other - control USA 0.00 [-0.10, 0.11]
self - control Netherlands 0.08 [-0.04, 0.20]
self - control USA 0.09 [-0.02, 0.21]

summary

summary(mod_h4b)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: mentalizing ~ cond * site + (1 + cond | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 17080.5
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -3.6468 -0.6627  0.0257  0.6723  3.3640 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr       
##  pID      (Intercept) 0.16482  0.4060              
##           condother   0.03657  0.1912   -0.20      
##           condself    0.06981  0.2642    0.01  0.74
##  Residual             0.98338  0.9917              
## Number of obs: 5947, groups:  pID, 84
## 
## Fixed effects:
##                   Estimate Std. Error       df t value Pr(>|t|)    
## (Intercept)        0.11587    0.07184 82.03020   1.613 0.110640    
## condother          0.11698    0.05477 81.59271   2.136 0.035695 *  
## condself           0.07688    0.06185 81.51161   1.243 0.217404    
## siteUSA            0.36486    0.09928 82.05893   3.675 0.000423 ***
## condother:siteUSA -0.11299    0.07566 81.51014  -1.493 0.139230    
## condself:siteUSA   0.01486    0.08551 81.67814   0.174 0.862507    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndthr cndslf sitUSA cndt:USA
## condother   -0.365                              
## condself    -0.226  0.582                       
## siteUSA     -0.724  0.264  0.164                
## cndthr:sUSA  0.264 -0.724 -0.421 -0.365         
## cndslf:sUSA  0.163 -0.421 -0.723 -0.226  0.582

combined plot

predicted_h4 = ggeffects::ggpredict(mod_h4a, c("cond", "site")) %>%
  data.frame() %>%
  mutate(atlas = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h4b, c("cond", "site")) %>%
              data.frame() %>%
              mutate(atlas = "mentalizing")) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")),
         atlas = factor(atlas, levels = c("self-referential", "mentalizing")))

ind_data_h4 = merged %>%
  filter(atlas %in% c("self-referential", "mentalizing")) %>%
  select(site, pID, cond, run, trial, atlas, parameter_estimate_std) %>%
  unique() %>%
  rename("x" = cond,
         "predicted" = parameter_estimate_std,
         "group" = site) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")),
         atlas = factor(atlas, levels = c("self-referential", "mentalizing")))

(plot_h4 = predicted_h4 %>%
  ggplot(aes(x = x, y = predicted, color = group)) +
  stat_summary(data = ind_data_h4, aes(group = pID), fun = "mean", geom = "line", size = .1) +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1, position = position_dodge(.1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high, group = group),
                  size = .75, position = position_dodge(.1)) +
  facet_grid(~atlas) +
  scale_color_manual(name = "", values = palette_sample) +
  labs(x = "", y = "ROI activity (SD)\n") +
  plot_aes +
  theme(legend.position = c(.85, .15)))

H5

Are the effects of the experimental manipulations on sharing intentions moderated by cultural context?

These data are not consistent with moderation by cultural context.

mod_h5 = lmer(value ~ cond * site + (1 | pID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

plot

predicted_h5 = ggeffects::ggpredict(mod_h5, c("cond", "site")) %>%
  data.frame() %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))

ind_data_h5 = merged_wide %>%
  rename("x" = cond,
         "predicted" = value,
         "group" = site) %>%
  mutate(x = factor(x, levels = c("self", "control", "other")))
  
predicted_h5 %>%
  ggplot(aes(x = x, y = predicted, color = group)) +
  stat_summary(data = ind_data_h5, aes(group = pID), fun = "mean", geom = "line", size = .1) +
  stat_summary(aes(group = group), fun = "mean", geom = "line", size = 1, position = position_dodge(.1)) +
  geom_pointrange(aes(ymin = conf.low, ymax = conf.high, group = group),
                  size = .75, position = position_dodge(.1)) +
  scale_color_manual(name = "", values = palette_sample) +
  labs(x = "", y = "predicted sharing intention\n") +
  plot_aes +
  theme(legend.position = c(.85, .15))

model table

table_h5 = table_model(mod_h5, print = FALSE)

table_h5 %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept 2.61 [2.49, 2.74] 122.57 42.83 < .001
other -0.01 [-0.10, 0.08] 5780.65 -0.26 .798
self -0.05 [-0.14, 0.04] 5780.51 -1.06 .290
sample (USA) 0.06 [-0.11, 0.23] 122.22 0.69 .491
other x sample (USA) -0.04 [-0.16, 0.08] 5780.50 -0.61 .545
self x sample (USA) 0.00 [-0.12, 0.13] 5780.49 0.06 .950

simple slopes

simple_slopes(mod_h5, "cond", "site", continuous = FALSE)
contrast site b [95% CI]
other - control Netherlands -0.01 [-0.10, 0.08]
other - control USA -0.05 [-0.13, 0.03]
self - control Netherlands -0.05 [-0.14, 0.04]
self - control USA -0.04 [-0.13, 0.04]

summary

summary(mod_h5)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ cond * site + (1 | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16491.6
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.5672 -0.7046  0.1168  0.7272  2.0362 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev.
##  pID      (Intercept) 0.1085   0.3293  
##  Residual             0.9395   0.9693  
## Number of obs: 5868, groups:  pID, 84
## 
## Fixed effects:
##                      Estimate  Std. Error          df t value
## (Intercept)          2.614281    0.061040  122.573084  42.829
## condother           -0.011536    0.045053 5780.647658  -0.256
## condself            -0.047549    0.044979 5780.506218  -1.057
## siteUSA              0.058224    0.084278  122.223484   0.691
## condother:siteUSA   -0.037566    0.062069 5780.500146  -0.605
## condself:siteUSA     0.003864    0.062073 5780.490191   0.062
##                              Pr(>|t|)    
## (Intercept)       <0.0000000000000002 ***
## condother                       0.798    
## condself                        0.290    
## siteUSA                         0.491    
## condother:siteUSA               0.545    
## condself:siteUSA                0.950    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) cndthr cndslf sitUSA cndt:USA
## condother   -0.369                              
## condself    -0.369  0.500                       
## siteUSA     -0.724  0.267  0.267                
## cndthr:sUSA  0.268 -0.726 -0.363 -0.368         
## cndslf:sUSA  0.268 -0.362 -0.725 -0.368  0.500

H6

Are the relationships between ROI activity positively and sharing intentions moderated by cultural context?

self-referential ROI

These data are not consistent with moderation by cultural context.

mod_h6a = lmer(value ~ self_referential * site + (1 + self_referential | pID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h6a = table_model(mod_h6a, print = FALSE)

table_h6a %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept 2.60 [2.49, 2.71] 81.88 46.48 < .001
self-referential 0.06 [0.02, 0.10] 81.38 3.14 .002
sample (USA) 0.01 [-0.15, 0.16] 82.77 0.09 .932
self-referential x sample (USA) 0.04 [-0.01, 0.10] 79.91 1.59 .116

simple slopes

simple_slopes(mod_h6a, "self_referential", "site", continuous = TRUE)
site b [95% CI]
Netherlands 0.06 [0.02, 0.10]
USA 0.10 [0.07, 0.14]

summary

summary(mod_h6a)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ self_referential * site + (1 + self_referential | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16439.5
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.6162 -0.7257  0.1089  0.7447  2.3132 
## 
## Random effects:
##  Groups   Name             Variance Std.Dev. Corr 
##  pID      (Intercept)      0.111435 0.33382       
##           self_referential 0.001997 0.04469  -0.24
##  Residual                  0.929667 0.96419       
## Number of obs: 5868, groups:  pID, 84
## 
## Fixed effects:
##                           Estimate Std. Error        df t value
## (Intercept)               2.599678   0.055931 81.879031  46.480
## self_referential          0.061543   0.019615 81.384643   3.138
## siteUSA                   0.006647   0.077497 82.766324   0.086
## self_referential:siteUSA  0.042942   0.027015 79.911690   1.590
##                                      Pr(>|t|)    
## (Intercept)              < 0.0000000000000002 ***
## self_referential                      0.00237 ** 
## siteUSA                               0.93186    
## self_referential:siteUSA              0.11589    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) slf_rf sitUSA
## self_rfrntl -0.056              
## siteUSA     -0.722  0.040       
## slf_rfr:USA  0.041 -0.726 -0.115

mentalizing ROI

These data are not consistent with moderation by cultural context.

mod_h6b = lmer(value ~ mentalizing * site + (1 + mentalizing | pID),
              data = merged_wide,
              control = lmerControl(optimizer = "bobyqa"))

model table

table_h6b = table_model(mod_h6b, print = FALSE)

table_h6b %>%
    kable()  %>%
    kableExtra::kable_styling()
term b [95% CI] df t p
intercept 2.58 [2.47, 2.69] 81.49 46.25 < .001
mentalizing 0.06 [0.02, 0.10] 81.07 3.14 .002
sample (USA) 0.01 [-0.14, 0.17] 83.32 0.16 .872
mentalizing x sample (USA) 0.03 [-0.03, 0.08] 80.15 0.95 .343

simple slopes

simple_slopes(mod_h6b, "mentalizing", "site", continuous = TRUE)
site b [95% CI]
Netherlands 0.06 [0.02, 0.10]
USA 0.09 [0.05, 0.12]

summary

summary(mod_h6b)
## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: value ~ mentalizing * site + (1 + mentalizing | pID)
##    Data: merged_wide
## Control: lmerControl(optimizer = "bobyqa")
## 
## REML criterion at convergence: 16451.3
## 
## Scaled residuals: 
##     Min      1Q  Median      3Q     Max 
## -2.5968 -0.7270  0.1114  0.7429  2.2347 
## 
## Random effects:
##  Groups   Name        Variance Std.Dev. Corr 
##  pID      (Intercept) 0.110680 0.3327        
##           mentalizing 0.001918 0.0438   -0.09
##  Residual             0.931637 0.9652        
## Number of obs: 5868, groups:  pID, 84
## 
## Fixed effects:
##                     Estimate Std. Error       df t value             Pr(>|t|)
## (Intercept)          2.58330    0.05586 81.48686  46.249 < 0.0000000000000002
## mentalizing          0.06140    0.01956 81.06714   3.140              0.00236
## siteUSA              0.01256    0.07763 83.32466   0.162              0.87189
## mentalizing:siteUSA  0.02572    0.02698 80.15260   0.953              0.34329
##                        
## (Intercept)         ***
## mentalizing         ** 
## siteUSA                
## mentalizing:siteUSA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Correlation of Fixed Effects:
##             (Intr) mntlzn sitUSA
## mentalizing -0.087              
## siteUSA     -0.719  0.062       
## mntlzng:USA  0.063 -0.725 -0.134

combined plot

vals = seq(-4.5,4.5,.1)

predicted_h6 = ggeffects::ggpredict(mod_h6a, c("self_referential [vals]", "site")) %>%
  data.frame() %>%
  mutate(atlas = "self-referential") %>%
  bind_rows(ggeffects::ggpredict(mod_h6b, c("mentalizing [vals]", "site")) %>%
              data.frame() %>%
              mutate(atlas = "mentalizing")) %>%
  mutate(atlas = factor(atlas, levels = c("self-referential", "mentalizing")))

ind_data_h6 = merged %>%
  filter(atlas %in% c("self-referential", "mentalizing")) %>%
  select(site, pID, cond, run, trial, atlas, parameter_estimate_std, value) %>%
  rename("x" = parameter_estimate_std,
         "predicted" = value,
         "group" = site) %>%
  mutate(atlas = factor(atlas, levels = c("self-referential", "mentalizing")))

predicted_h6 %>%
  ggplot(aes(x = x, y = predicted, color = group, fill = group)) +
  stat_smooth(data = ind_data_h6, aes(group = interaction(pID, group)), geom ='line', method = "lm", alpha = .1, size = 1, se = FALSE) +
  geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .2, color = NA) +
  geom_line(size = 2) +
  facet_grid(~atlas) +
  scale_color_manual(name = "", values = palette_sample) +
  scale_fill_manual(name = "", values = palette_sample) +
  labs(y = "predicted sharing intention\n", x = "\nROI activity (SD)") +
  plot_aes +
  theme(legend.position = "top")



combined table

table_h1a %>% mutate(DV = "H1a: Self-relevance") %>%
  bind_rows(table_h1b %>% mutate(DV = "H1b: Social relevance")) %>%
  bind_rows(table_h2a %>% mutate(DV = "H2a: Self-relevance")) %>%
  bind_rows(table_h2b %>% mutate(DV = "H2b: Social relevance")) %>%
  bind_rows(table_h3 %>% mutate(DV = "H3a-b: Sharing intention")) %>%
  bind_rows(table_h4a %>% mutate(DV = "H4a: Self-referential ROI")) %>%
  bind_rows(table_h4b %>% mutate(DV = "H4b: Mentalizing ROI")) %>%
  bind_rows(table_h5 %>% mutate(DV = "H5: Sharing intention")) %>%
  bind_rows(table_h6a %>% mutate(DV = "H6a: Sharing intention")) %>%
  bind_rows(table_h6b %>% mutate(DV = "H6b: Sharing intention")) %>%
  select(DV, everything()) %>%
  kable() %>%
  kable_styling()
DV term b [95% CI] df t p
H1a: Self-relevance intercept 2.61 [2.50, 2.72] 81.70 46.20 < .001
H1a: Self-relevance self-referential 0.04 [0.01, 0.08] 83.16 2.32 .023
H1a: Self-relevance sample (USA) -0.09 [-0.25, 0.06] 82.60 -1.17 .244
H1a: Self-relevance self-referential x sample (USA) 0.01 [-0.04, 0.07] 81.67 0.51 .613
H1b: Social relevance intercept 2.73 [2.61, 2.85] 80.99 45.45 < .001
H1b: Social relevance mentalizing 0.05 [0.01, 0.08] 82.37 2.58 .012
H1b: Social relevance sample (USA) -0.14 [-0.30, 0.03] 82.36 -1.63 .107
H1b: Social relevance mentalizing x sample (USA) 0.01 [-0.04, 0.06] 81.96 0.27 .786
H2a: Self-relevance intercept 2.58 [2.46, 2.70] 119.16 41.92 < .001
H2a: Self-relevance other 0.04 [-0.05, 0.12] 5859.38 0.84 .400
H2a: Self-relevance self 0.04 [-0.04, 0.13] 5859.19 0.95 .344
H2a: Self-relevance sample (USA) -0.05 [-0.21, 0.12] 119.21 -0.53 .597
H2a: Self-relevance other x sample (USA) -0.06 [-0.17, 0.06] 5859.27 -0.91 .364
H2a: Self-relevance self x sample (USA) -0.02 [-0.14, 0.10] 5859.27 -0.33 .745
H2b: Social relevance intercept 2.73 [2.60, 2.86] 109.20 42.42 < .001
H2b: Social relevance other 0.02 [-0.06, 0.10] 5859.32 0.42 .674
H2b: Social relevance self 0.00 [-0.08, 0.08] 5859.17 0.06 .954
H2b: Social relevance sample (USA) -0.16 [-0.34, 0.01] 109.23 -1.83 .069
H2b: Social relevance other x sample (USA) 0.06 [-0.05, 0.17] 5859.24 1.07 .286
H2b: Social relevance self x sample (USA) 0.08 [-0.03, 0.19] 5859.24 1.46 .145
H3a-b: Sharing intention intercept 1.14 [0.95, 1.32] 82.45 11.97 < .001
H3a-b: Sharing intention self-relevance 0.32 [0.27, 0.38] 87.57 11.16 < .001
H3a-b: Sharing intention sample (USA) 0.09 [-0.17, 0.34] 76.19 0.69 .489
H3a-b: Sharing intention social relevance 0.23 [0.15, 0.31] 87.18 5.89 < .001
H3a-b: Sharing intention self-relevance x sample (USA) -0.04 [-0.12, 0.04] 83.20 -1.07 .289
H3a-b: Sharing intention sample (USA) x social relevance 0.04 [-0.06, 0.15] 81.62 0.81 .419
H4a: Self-referential ROI intercept -0.15 [-0.30, 0.00] 81.97 -1.99 .050
H4a: Self-referential ROI other 0.11 [-0.00, 0.22] 81.68 1.94 .055
H4a: Self-referential ROI self 0.09 [-0.04, 0.21] 81.47 1.35 .179
H4a: Self-referential ROI sample (USA) 0.42 [0.21, 0.62] 81.99 4.01 < .001
H4a: Self-referential ROI other x sample (USA) -0.06 [-0.21, 0.10] 81.60 -0.73 .470
H4a: Self-referential ROI self x sample (USA) 0.03 [-0.15, 0.20] 81.63 0.31 .761
H4b: Mentalizing ROI intercept 0.12 [-0.03, 0.26] 82.03 1.61 .111
H4b: Mentalizing ROI other 0.12 [0.01, 0.23] 81.59 2.14 .036
H4b: Mentalizing ROI self 0.08 [-0.05, 0.20] 81.51 1.24 .217
H4b: Mentalizing ROI sample (USA) 0.36 [0.17, 0.56] 82.06 3.68 < .001
H4b: Mentalizing ROI other x sample (USA) -0.11 [-0.26, 0.04] 81.51 -1.49 .139
H4b: Mentalizing ROI self x sample (USA) 0.01 [-0.16, 0.18] 81.68 0.17 .863
H5: Sharing intention intercept 2.61 [2.49, 2.74] 122.57 42.83 < .001
H5: Sharing intention other -0.01 [-0.10, 0.08] 5780.65 -0.26 .798
H5: Sharing intention self -0.05 [-0.14, 0.04] 5780.51 -1.06 .290
H5: Sharing intention sample (USA) 0.06 [-0.11, 0.23] 122.22 0.69 .491
H5: Sharing intention other x sample (USA) -0.04 [-0.16, 0.08] 5780.50 -0.61 .545
H5: Sharing intention self x sample (USA) 0.00 [-0.12, 0.13] 5780.49 0.06 .950
H6a: Sharing intention intercept 2.60 [2.49, 2.71] 81.88 46.48 < .001
H6a: Sharing intention self-referential 0.06 [0.02, 0.10] 81.38 3.14 .002
H6a: Sharing intention sample (USA) 0.01 [-0.15, 0.16] 82.77 0.09 .932
H6a: Sharing intention self-referential x sample (USA) 0.04 [-0.01, 0.10] 79.91 1.59 .116
H6b: Sharing intention intercept 2.58 [2.47, 2.69] 81.49 46.25 < .001
H6b: Sharing intention mentalizing 0.06 [0.02, 0.10] 81.07 3.14 .002
H6b: Sharing intention sample (USA) 0.01 [-0.14, 0.17] 83.32 0.16 .872
H6b: Sharing intention mentalizing x sample (USA) 0.03 [-0.03, 0.08] 80.15 0.95 .343

cite packages

report::cite_packages()
##   - Angelo Canty and Brian Ripley (2021). boot: Bootstrap R (S-Plus) Functions. R package version 1.3-28.
##   - Douglas Bates, Martin Maechler and Mikael Jagan (2023). Matrix: Sparse and Dense Matrix Classes and Methods. R package version 1.5-4. https://CRAN.R-project.org/package=Matrix
##   - Douglas Bates, Martin Maechler, Ben Bolker, Steve Walker (2015). Fitting Linear Mixed-Effects Models Using lme4. Journal of Statistical Software, 67(1), 1-48. doi:10.18637/jss.v067.i01.
##   - H. Wickham. ggplot2: Elegant Graphics for Data Analysis. Springer-Verlag New York, 2016.
##   - Hadley Wickham (2019). stringr: Simple, Consistent Wrappers for Common String Operations. R package version 1.4.0. https://CRAN.R-project.org/package=stringr
##   - Hadley Wickham (2021). forcats: Tools for Working with Categorical Variables (Factors). R package version 0.5.1. https://CRAN.R-project.org/package=forcats
##   - Hadley Wickham and Maximilian Girlich (2022). tidyr: Tidy Messy Data. R package version 1.2.0. https://CRAN.R-project.org/package=tidyr
##   - Hadley Wickham, Jennifer Bryan and Malcolm Barrett (2021). usethis: Automate Package and Project Setup. R package version 2.1.5. https://CRAN.R-project.org/package=usethis
##   - Hadley Wickham, Jim Hester and Jennifer Bryan (2022). readr: Read Rectangular Text Data. R package version 2.1.2. https://CRAN.R-project.org/package=readr
##   - Hadley Wickham, Jim Hester, Winston Chang and Jennifer Bryan (2021). devtools: Tools to Make Developing R Packages Easier. R package version 2.4.3. https://CRAN.R-project.org/package=devtools
##   - Hadley Wickham, Romain François, Lionel Henry and Kirill Müller (2022). dplyr: A Grammar of Data Manipulation. R package version 1.0.9. https://CRAN.R-project.org/package=dplyr
##   - Hao Zhu (2021). kableExtra: Construct Complex Table with 'kable' and Pipe Syntax. R package version 1.3.4. https://CRAN.R-project.org/package=kableExtra
##   - Jim Hester, Hadley Wickham and Gábor Csárdi (2021). fs: Cross-Platform File System Operations Based on 'libuv'. R package version 1.5.2. https://CRAN.R-project.org/package=fs
##   - Kirill Müller and Hadley Wickham (2022). tibble: Simple Data Frames. R package version 3.1.8. https://CRAN.R-project.org/package=tibble
##   - Kuznetsova A, Brockhoff PB, Christensen RHB (2017). "lmerTest Package:Tests in Linear Mixed Effects Models." _Journal of StatisticalSoftware_, *82*(13), 1-26. doi: 10.18637/jss.v082.i13 (URL:https://doi.org/10.18637/jss.v082.i13).
##   - Lionel Henry and Hadley Wickham (2020). purrr: Functional Programming Tools. R package version 0.3.4. https://CRAN.R-project.org/package=purrr
##   - Lüdecke D (2018). "ggeffects: Tidy Data Frames of Marginal Effects fromRegression Models." _Journal of Open Source Software_, *3*(26), 772.doi: 10.21105/joss.00772 (URL: https://doi.org/10.21105/joss.00772).
##   - R Core Team (2021). R: A language and environment for statistical computing. R Foundation for Statistical Computing, Vienna, Austria. URL https://www.R-project.org/.
##   - Rinker, T. W. & Kurkiewicz, D. (2017). pacman: Package Management for R. version 0.5.0. Buffalo, New York. http://github.com/trinker/pacman
##   - Wickham et al., (2019). Welcome to the tidyverse. Journal of Open Source Software, 4(43), 1686, https://doi.org/10.21105/joss.01686
##   - Yihui Xie (2021). knitr: A General-Purpose Package for Dynamic Report Generation in R. R package version 1.37.